home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr18 / sub40.zip / SUB.PRG < prev    next >
Text File  |  1993-06-01  |  2KB  |  66 lines

  1. * SUB.PRG written by Michael MacDonald. (c)1993 Revised 2/13/93
  2. *
  3. IF ISCOLOR()
  4.    SET COLOR TO W/B
  5. ENDIF
  6. pext1=""
  7. pext2=""
  8. PARAMETERS pext1,pext2
  9. SET TALK OFF
  10. SET CONFIRM OFF
  11. SET CURSOR OFF
  12. CLEAR
  13. @ 1,22 SAY "SUB v4.0 by Michael MacDonald  (c)1993"
  14. @ 2,5 SAY "A program to replace the file extensions in ROBOCOMM's new files list"
  15. @ 4,5 SAY "░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░"
  16. num=0
  17. count=0
  18. DO CASE
  19. CASE FILE("new40.dbf")
  20.    USE new40
  21.    @ 6,5 SAY "Using NEW40.DBF"
  22. CASE FILE("new50.dbf")
  23.    USE new50
  24.    @ 6,5 SAY "Using NEW50.DBF"
  25. OTHERWISE
  26.    @ 6,5 SAY "Can't find NEWxx.DBF"
  27.    ?
  28.    SET CURSOR ON
  29.    QUIT
  30. ENDCASE
  31. ext=UPPER(RTRIM(pext1))
  32. newext=UPPER(RTRIM(pext2))
  33. IF ext="/?" .OR. ext="?"
  34. @ 6,5 SAY "The correct syntax is SUB <ext to replace> <replacement>"
  35. CLOSE ALL
  36. SET CURSOR ON
  37. QUIT
  38. ENDIF
  39. DO WHILE .NOT. EOF()
  40.    msize=RECCOUNT()
  41.    @ 8,5 SAY "Searching for files with "+ext+" extensions"
  42.    num=num+1
  43.    line=INT((num/msize)*69)
  44.    IF line>0
  45.       @ 4,4+line SAY "█"
  46.    ENDIF
  47.    IF msize < 68 .AND. line < 68
  48.       @ 4,5+line SAY "█"
  49.    ENDIF
  50.    pos=AT(".",file_name)
  51.    IF UPPER(SUBSTR(file_name,(pos+1),3))=ext
  52.       oldfile=file_name
  53.       file=STUFF(file_name,(pos+1),3,newext)
  54.       REPL file_name WITH FILE
  55.       count=count+1
  56.       @ 9,5 SAY "Renaming -->"+oldfile+" to "+FILE
  57.    ENDIF
  58.    SKIP
  59. ENDDO
  60. @ 10,5 SAY "Renamed "+LTRIM(STR(count))+" files"
  61. CLOSE ALL
  62. SET CURSOR ON
  63. QUIT
  64. *
  65. * EOF SUB.PRG
  66.